Collection of Tools & Utilities/Collection of Tools and Utilities.iso/pascal/zip2obj.zip/XZIP.PAS

Pascal/Delphi Source File | 1991-11-12 | 13KB | 552 lines

{ XZIP.PAS - Explode data to memory routine (c) Wilbert van Leijen, 1991 }

Unit XZip;

Interface

Procedure Explode(Var InBuffer, OutBuffer; CompressedSize : Word);

Implementation

{$S-
   USAGE NOTES:
     -  Do not call Explode direct.  It is called by an linked in .OBJ
        file, generated by ZIP2OBJ.
     -  Maximum size of the uncompressed image is 64 kB
     -  Memory requirements:  3k data, 10 k stack                       }

Const
  MaxDictSize  = 8192;
  BufSize      = 65520;                { Size of buffers for I/O }
  MaxSFTreeSize = (1 shl 9)-1;
  LitTreeRoot  = (1 shl 9)-1;
  DistTreeRoot = (1 shl 7)-1;
  LenTreeRoot  = (1 shl 7)-1;
  CodeValue    : Array[1..8] of Byte = (
    $01, $03, $07, $0F, $1F, $3F, $7F, $FF);

Type
  BufType      = Array[0..BufSize] of Byte;
  SFNode       = Record
                   lChild        : Integer;
                   rChild        : Integer;
                 end;
  SFBuildRec   = Record
                   Len, Val    : Byte;
                   Code        : Word;
                 end;
  SFBuildArray = Array[0..255] of SFBuildRec;

Var
  SFLiteral    : Array[0..LitTreeRoot] of SFNode;
  SFDist       : Array[0..DistTreeRoot] of SFNode;
  SFLength     : Array[0..LenTreeRoot] of SFNode;
  InfileBuf    : ^BufType;
  DictSize     : Integer;
  InBufPtr,
  SFNextFree   : Word;
  BitsLeft,                            { Unprocessed bits in input code buffer }
  SaveByte,                            { Input code buffer - 1 byte long }
  SFBuildIdx,                          { Index var for SFBuild array }
  NumOfTrees   : Byte;                 { SF trees needed (2 or 3) }

Const
  SFTreeRec    : Array[0..2] of Pointer = (
                   @SFLiteral, @SFLength, @SFDist);
  SFFreeRoot   : Array[0..2] of Word = (
                   LitTreeRoot, LenTreeRoot, DistTreeRoot);

Function GetCode : Byte; Assembler;

ASM
        PUSH   BX
        PUSH   CX
        PUSH   DX
        MOV    DH, AL
        MOV    AH, [BitsLeft]
        MOV    DL, DH
        XOR    CH, CH
        XOR    BH, BH

@1:     CMP    DL, AH
        JB     @2

        MOV    BL, AH
        JMP    @3

@2:     MOV    BL, DL
@3:     MOV    CL, DH
        SUB    CL, DL
        MOV    AL, Byte Ptr [BX+CodeValue-1]
        AND    AL, [SaveByte]
        SHL    AL, CL
        OR     CH, AL
        MOV    CL, BL
        SHR    [SaveByte], CL
        SUB    DL, BL
        SUB    AH, BL
        OR     AH, AH
        JNE    @4

        LES    DI, [InfileBuf]
        ADD    DI, [InBufPtr]
        MOV    AL, ES:[DI]
        MOV    [SaveByte], AL
        INC    [InBufPtr]
        MOV    AH, 8

@4:     OR     DL, DL
        JNZ    @1

        MOV    [BitsLeft], AH
        MOV    AL, CH
        POP    DX
        POP    CX
        POP    BX
end;  { GetCode }

Procedure AddSFSubTree(SFB : SFBuildRec; SFRoot : Word; Var SFTree);
  Assembler;

ASM
        MOV    DI, [SFNextFree]
        PUSH   DS
        PUSH   BX
        PUSH   CX
        PUSH   DX
        MOV    BX, SFRoot
        MOV    CL, SFB.Len
        XOR    CH, CH
        DEC    CX

@1:     JCXZ   @6
        LDS    SI, SFTree
        SHL    BX, 1
        SHL    BX, 1
        ADD    SI, BX
        MOV    AX, SFB.Code
        SHR    AX, CL
        TEST   AX, 1
        JZ     @3

        CMP    [SI+SFNode.rChild], -1
        JNE    @2
        MOV    [SI+SFNode.rChild], DI
        DEC    DI

@2:     MOV    BX, [SI+SFNode.rChild]
        JMP    @5

@3:     CMP    [SI+SFNode.lChild], -1
        JNE    @4

        MOV    [SI.SFNode.lChild], DI
        DEC    DI

@4:     MOV    BX, [SI+SFNode.lChild]
@5:     DEC    CX
        JMP    @1

@6:     LDS    SI, SFTree
        SHL    BX, 1
        SHL    BX, 1
        ADD    SI, BX

        MOV    AL, SFB.Val
        XOR    AH, AH
        TEST   SFB.Code, 1
        JZ     @7

        MOV    [SI+SFNode.rChild], AX
        JMP    @8

@7:     MOV    [SI+SFNode.lChild], AX

@8:     POP    DX
        POP    CX
        POP    BX
        POP    DS
        MOV    [SFNextFree], DI
end;  { AddSFSubTree }

Procedure ShellSort(Var SFB; n : Integer); Assembler;

Var
  gap          : Integer;

ASM
        PUSH   DS
        PUSH   BX
        LDS    DI, SFB
        MOV    AX, n
        SHR    AX, 1
        MOV    gap, AX

@1:     CMP    gap, 0
        JNG    @8

        MOV    DX, gap
        INC    DX

@2:     MOV    AX, DX
        SUB    AX, gap
        MOV    CX, AX

@3:     CMP    CX, 0
        JNG    @7

        MOV    SI, CX
        ADD    SI, gap
        MOV    BX, CX
        DEC    BX
        SHL    BX, 1
        SHL    BX, 1
        ADD    BX, DI
        DEC    SI
        SHL    SI, 1
        SHL    SI, 1
        ADD    SI, DI
        MOV    AL, [BX+SFBuildRec.Len]
        CMP    AL, [SI+SFBuildRec.Len]
        JA     @5
        MOV    AL, [BX+SFBuildRec.Len]
        CMP    AL, [SI+SFBuildRec.Len]
        JNE    @4
        MOV    AL, [BX+SFBuildRec.Val]
        CMP    AL, [SI+SFBuildRec.Val]
        JA     @5

@4:     XOR    CX, CX
        JMP    @6

@5:     MOV    AX, [BX]
        PUSH   AX
        MOV    AX, [SI]
        MOV    [BX], AX
        POP    AX
        MOV    [SI], AX

@6:     MOV    AX, gap
        SUB    CX, AX
        JMP    @3

@7:     INC    DX
        CMP    DX, n
        JBE    @2

        MOV    AX, gap
        SHR    AX, 1
        MOV    gap, AX
        JMP    @1

@8:     POP    BX
        POP    DS
end;  { ShellSort }

Procedure BuildSFTree(WhichTree : Byte; Var SFBuild : SFBuildArray);
  Assembler;

Var
  Code         : Word;

ASM
        CMP     [NumOfTrees], 2
        JNE     @1
        INC     WhichTree

@1:     MOV     AL, WhichTree
        XOR     AH, AH
        MOV     DI, AX
        SHL     DI, 1
        MOV     AX, Word Ptr [DI+SFFreeRoot]
        DEC     AX
        MOV     [SFNextFree], AX
        XOR     BL, BL
        MOV     AL, 8
        CALL    GetCode
        MOV     BH, AL
        XOR     CH, CH

@3:     MOV     AL, 8
        CALL    GetCode
        MOV     DL, AL
        AND     AL, 15
        INC     AL
        MOV     DH, AL
        MOV     CL, 4
        SHR     DL, CL
        XOR     CL, CL

@2:     MOV     AL, BL
        XOR     AH, AH
        SHL     AX, 1
        SHL     AX, 1
        LES     DI, SFBuild
        ADD     DI, AX
        MOV     ES:[DI+SFBuildRec.Len], DH
        MOV     ES:[DI+SFBuildRec.Val], BL
        INC     BL
        INC     CL
        CMP     DL, CL
        JNB     @2

        INC     CH
        CMP     CH, BH
        JBE     @3

        LES     DI, SFBuild
        PUSH    ES
        PUSH    DI
        MOV     AL, BL
        DEC     AL
        XOR     AH, AH
        INC     AX
        PUSH    AX
        CALL    ShellSort
        XOR     AX, AX
        MOV     Code, AX
        XOR     CH, CH
        XOR     DX, DX
        DEC     BL
        XOR     BH, BH
        OR      BX, BX
        JB      @5
        JMP     @6

@8:     DEC     BX

@6:     ADD     Code, DX
        MOV     AX, BX
        SHL     AX, 1
        SHL     AX, 1
        LES     DI, SFBuild
        ADD     DI, AX
        MOV     AL, ES:[DI+SFBuildRec.Len]
        CMP     AL, CH
        JE      @7
        MOV     CH, ES:[DI+SFBuildRec.Len]
        MOV     CL, 16
        SUB     CL, CH
        MOV     DX, 1
        SHL     DX, CL

@7:     MOV     CL, 16
        SUB     CL, ES:[DI+SFBuildRec.Len]
        MOV     AX, Code
        SHR     AX, CL
        MOV     ES:[DI+SFBuildRec.Code], AX
        PUSH    Word Ptr ES:[DI+SFBuildRec.Code]
        PUSH    Word Ptr ES:[DI+SFBuildRec.Len]
        MOV     AL, WhichTree
        XOR     AH, AH
        MOV     DI, AX
        SHL     DI, 1
        PUSH    Word Ptr [DI+SFFreeRoot]
        SHL     DI, 1
        LES     DI, DWord Ptr [DI+SFTreeRec]
        PUSH    ES
        PUSH    DI
        CALL    AddSFSubTree
        OR      BX, BX
        JNZ     @8
@5:
end